home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / SPADV.ZIP / SPADV.PAS < prev    next >
Pascal/Delphi Source File  |  1994-03-17  |  25KB  |  788 lines
  1. program SPACE_ADVENTURE;
  2.  
  3.                      (****** UNIT SPECIFICATIONS ******)
  4. uses
  5.     Crt,Graph3,Graph,Globals,Title,Ending,Evalu,Misc;
  6.  
  7.                 (**** PROCEDURE AND FUNCTION DECLARATIONS ****)
  8.  
  9.                                                                                          (***** MESSAGE PROCESSING *****)
  10. procedure Message (Txt:Str80);
  11. begin
  12.   SetColor(3);
  13.   SetTextJustify (CenterText,BottomText);
  14.   OutTextXY (160,166,Txt);
  15.   SetTextJustify (LeftText,TopText);
  16.   SetColor(0);
  17. end;
  18.  
  19. procedure ClearMessage;
  20. begin
  21.   Black (1,159,318,168);
  22. end;
  23.  
  24.                                          (**** WEAPON & LIFE SUPPORT ****)
  25. procedure DrawBar (Length,Ypos:word; Danger:boolean);
  26. begin
  27.   SetLineStyle (0,0,ThickWidth);
  28.   MoveTo (0,Ypos);
  29.   if Danger then begin
  30.     SetColor(2);
  31.     if Length>0 then Line(0,Ypos,Lowest(40,Length),Ypos);
  32.     MoveTo(Lowest(40,Length),Ypos);
  33.   end;
  34.   if Length>GetX then begin
  35.     SetColor(3);
  36.     Line (GetX,Ypos,Length,Ypos);
  37.   end;
  38.   SetLineStyle (0,0,NormWidth);
  39.   SetColor(0);
  40. end;
  41.  
  42. procedure UsePpack (var Support:integer; Ypos:word);
  43. begin
  44.   if Ppacks>0 then begin
  45.     Support:=Lowest(300,Support+230);
  46.     for Ctr:=1 to 700 do Sound (Ctr*2);     { Whoooouuuuiiiiiipp (!) }
  47.     NoSound;
  48.     DrawBar (Support,Ypos,Ypos=178);
  49.     Black (255+Ppacks*10,146,260+Ppacks*10,152);
  50.     Dec (Ppacks);             { Packs used is a penalty when calculating }
  51.     Inc (PpacksUsed);         { the total score }
  52.   end;
  53. end;
  54.  
  55. procedure DecSupport (var Support:integer; Penalty,Ypos:word);
  56. var NewSupp:integer;
  57. begin
  58.   NewSupp:=Support-Penalty;
  59.   if NewSupp<0 then NewSupp:=0;
  60.   Black (NewSupp,Ypos-1,Support,Ypos+1);
  61.   Support:=NewSupp;
  62. end;
  63.  
  64. procedure SelectWeapon (NewWeapon:WeapTyp);
  65. begin
  66.   if NewWeapon<>Weapon then begin
  67.     SetColor(1); TextSize (9,10,4,5);
  68.     Black (0,181+(Ord(Weapon)*10),34,185+(Ord(Weapon)*10));
  69.     if Weapon=Phaser then begin
  70.                             OutTextXY(0,179,'PHASER');
  71.                             BulSound := 600;
  72.                           end
  73.                      else begin
  74.                             OutTextXY(0,189,'BLASTER');
  75.                             BulSound := 90;
  76.                           end;
  77.     Weapon:=NewWeapon;
  78.     SetFillStyle (1,3); SetColor (0);
  79.     Bar (0,181+(Ord(Weapon)*10),34,185+(Ord(Weapon)*10));
  80.     if Weapon=Phaser then OutTextXY(0,179,'PHASER')
  81.                      else OutTextXY(0,189,'BLASTER');
  82.     TextSize(1,1,1,1);
  83.   end;
  84. end;
  85.                                             (***** LOAD ICONS *****)
  86. procedure LoadIcons;
  87. var
  88.   Ctr,Ctr2,Size:integer;
  89.   X,x1,Y,y1,d:byte;
  90.   FilVar:file of byte;
  91. begin
  92.   Assign (FilVar,SAdir+'ICONS.DAT');
  93.     Reset (FilVar);
  94.     for Ctr:=1 to NoofIcons do begin
  95.         for Ctr2:=1 to 4 do
  96.             Read (FilVar,Icon[Ctr,Ctr2]);
  97.         Size:=ImageSize(0,0,Icon[Ctr,2]*256+Icon[Ctr,1],Icon[Ctr,4]*256+Icon[Ctr,3]);
  98.         for Ctr2:=5 to Size do begin        { Icons are of variable sizes, }
  99.             Read (FilVar,Icon[Ctr,Ctr2]);     { therefore the complicated stuff }
  100.         end;
  101.     end;
  102.   Close (FilVar);
  103. end;
  104.                                                                                  (***** LOAD SHIP & PUT ObjektS ****)
  105. procedure PutObjekt(Obj:byte);
  106. var
  107.   l,x,y,Room:byte;
  108.   Found:boolean;
  109. begin
  110.   if Obj>=Crystal then repeat
  111.     Room:=Random(10)+1;
  112.     l:=OneWay[Room,1]; x:=OneWay[Room,2]; y:=OneWay[Room,3];
  113.     until (Ship[l,x,y].Objekt=0)
  114.   else repeat
  115.     l:=Random(3)+1; x:=Random(13)+2; y:=Random(3)+1;
  116.     with Ship[l,x,y] do
  117.             Found:=not ((Objekt>0) or
  118.                  ((x>3) and (x<9) and (y<>2)) or
  119.                  ((x=12) and (y=2)));
  120.   until Found;
  121.     Ship[l,x,y].Objekt:=Obj;
  122. end;
  123.  
  124. procedure InitShip;
  125. begin
  126.   Assign (ShipFile,SAdir+'SHIP.DAT');
  127.   Reset (ShipFile);
  128.   Read (ShipFile, Ship);
  129.   Close (ShipFile);
  130.     for Ctr:=0 to 3 do begin      { Put the 'takeable' Objekts at random }
  131.         PutObjekt(Key+Ctr);
  132.         PutObjekt(Crystal+Ctr);
  133.   end;
  134.   for Ctr:=1 to 13+Skill*2 do
  135.         PutObjekt(Ppack);
  136. end;
  137.                                                   (***** MAP PROCESSING *****)
  138. procedure UpdateMap (l,x,y:byte; Outstand:boolean);
  139. var Rx,Ry:word;
  140.  
  141.   procedure Tri(Typ:byte);
  142.   begin
  143.     case Typ of
  144.       1: begin MoveTo(Rx,Ry+3); LineRel(3,-3); LineRel (0,6); LineRel (-3,-3);
  145.            MoveRel(1,0); LineRel(1,1); LineRel(0,-2); end;
  146.       2: begin MoveTo(Rx+4,Ry+3); LineRel(2,-2); LineRel (0,4); LineRel (-1,-1);
  147.            LineRel(0,-1); end;
  148.       3: begin MoveTo(Rx+1,Ry+6); LineRel(5,-5); LineRel (0,5); LineRel (-4,0);
  149.            LineRel(3,-3); LineRel(0,2); LineRel(-1,0); end;
  150.       4: begin MoveTo(Rx+5,Ry+6); LineRel(-5,-5); LineRel (0,5); LineRel (4,0);
  151.            LineRel(-3,-3); LineRel(0,2); LineRel(1,0); end;
  152.       5: begin MoveTo(Rx+5,Ry); LineRel(-5,5); LineRel (0,-5); LineRel (4,0);
  153.            LineRel(-3,3); LineRel(0,-2); LineRel(1,0); end;
  154.       6: begin MoveTo(Rx+1,Ry); LineRel(5,5); LineRel (0,-5); LineRel (-4,0);
  155.            LineRel(3,3); LineRel(0,-2); LineRel(-1,0); end;
  156.     end;
  157.   end;
  158.  
  159.   procedure Room;
  160.   begin
  161.     Rectangle (Rx,Ry,Rx+6,Ry+6);
  162.     if Outstand then SetColor(3) else SetColor(0);
  163.     with Ship[l,x,y] do begin
  164.       if (Interior and North)>0 then Line (Rx+2,Ry,Rx+4,Ry);
  165.       if (Interior and South)>0 then Line (Rx+2,Ry+6,Rx+4,Ry+6);
  166.       if (Interior and West)>0 then Line (Rx,Ry+2,Rx,Ry+4);
  167.       if (Interior and East)>0 then Line (Rx+6,Ry+2,Rx+6,Ry+4);
  168.     end;
  169.     SetColor(1);
  170.     if (y=2) and ((x=1) or (x=12)) then begin
  171.       Line(Rx+2,Ry+2,Rx+4,Ry+2); Line(Rx+3,Ry+2,Rx+3,Ry+4);
  172.     end;
  173.   end;
  174.  
  175. begin
  176.   Rx:=MapX+x*7; Ry:=MapY+y*7;
  177.   if Outstand then SetFillStyle(1,3) else SetFillStyle(1,0);
  178.   Bar(Rx+1,Ry+1,Rx+5,Ry+5); SetColor (1);
  179.   if (l=2) and (y=1) and ((x>4) and (x<8)) then begin
  180.     SetColor (2); case x of
  181.       5:Tri(2);
  182.       6:Room;
  183.       7:Tri(1);
  184.     end;
  185.   end
  186.   else if (y in [1,3]) and (x<15) then case y of
  187.     1:case x of
  188.            1,8:Tri(3);
  189.              4:Tri(4);
  190.         0,5..7:Black(Rx,Ry,Rx+6,Ry+6);
  191.         else Room;
  192.       end;
  193.     3:case x of
  194.            1,8:Tri(6);
  195.              4:Tri(5);
  196.         0,5..7:Black(Rx,Ry,Rx+6,Ry+6);
  197.         else Room;
  198.       end;
  199.   end
  200.   else if x=15 then Tri(1)
  201.   else if (y=2) and (x=0) then Tri(2)
  202.   else Room;
  203.   SetColor (0);
  204. end;
  205.  
  206. procedure DrawMap (Level:byte);
  207. begin
  208.   Black(32,152,57,156);
  209.   for Ctr2:=0 to 15 do
  210.     for Ctr:=1 to 3 do
  211.       UpdateMap (Level,Ctr2,Ctr,False);
  212.   SetColor (3);
  213.   TextSize (2,3,2,3);
  214.   OutTextXY (32,151,'Level '+St(Level));
  215.   TextSize (1,1,1,1);
  216. end;
  217.                                                     (***** INITIALIZE *****)
  218. procedure Initialize;
  219. begin
  220.   CheckBreak := not Debug;
  221.   FindFile ('ICONS.DAT');                       { Check for essential files }
  222.   FindFile ('SHIP.DAT');
  223.   FindFile ('TITLE.DAT');
  224.   Randomize;
  225.   Gd := CGA;
  226.   Gm := CGAC2;                     { Init graph mode }
  227.   InitGraph(Gd, Gm, '');
  228.   GraphColorMode;
  229.   BkColor:=1; GraphBackground (BkColor);
  230.   Palette (Gm);
  231.   SetTextJustify (CenterText,CenterText);
  232.   OutTextXY (160,100,'Please Wait ...');
  233.     Assign (TitleFile,SAdir+'TITLE.DAT');          { Load title screens }
  234.   Reset (TitleFile);                             { (Permanently) }
  235.   Read (TitleFile, Tit1, Tit2);
  236.   Close (TitleFile);
  237.   for Ctr:=1 to 16240 do begin
  238.     Dec (Tit1 [Ctr],25);
  239.     Dec (Tit2 [Ctr],25);
  240.   end;
  241.   ShwTitle:=False;
  242.   LoadIcons;
  243.   LoadHiScores;                      { If hiscores exist, load them }
  244.   Pause := 0; TempPause := Pause;
  245.   Noise := True;
  246.   Quit := False;
  247. end;
  248.  
  249. procedure InitGame;
  250. begin
  251.   ClearDevice;
  252.   TextSize (2,1,2,1);
  253.   SetTextJustify (CenterText,CenterText); SetColor (1);
  254.   OutTextXY (160,6,'SPACE ADVENTURE');
  255.   TextSize (1,1,9,10);
  256.   OutTextXY (160,19,'VERSION 2.01 RELEASE 2');
  257.   TextSize (1,1,4,5);
  258.              { The name of the author is coded so that patchers get problems }
  259.   OutTextXY (160,187,DeCode('¿├⌐á├╧╨┘╥╔╟╚╘á▒╣╕╕á╞╔╥┼┬┴╠╠á╙╧╞╘╫┴╥┼á╠╘─«'));
  260.   OutTextXY (160,195,DeCode('╨╥╧╟╥┴══╔╬╟¼á╟╥┴╨╚╔├╙á┴╬─á╙╧╒╬─á┬┘á╥╧┬┼╥╘á╙├╚═╔─╘'));
  261.  
  262.   SetTextJustify (LeftText,TopText); SetColor (3);
  263.   TextSize (1,1,1,1);
  264.   PutImage (120,100,Icon[16],0);             { Show some characters and ... }
  265.   PutImage (117,110,Icon[17],0);
  266.   PutImage (115,120,Icon[18],0);
  267.   PutImage (115,136,Icon[4],0);
  268.   for Ctr:=0 to 3 do
  269.     PutImage (117-Ctr*15,160,Icon[6+Ctr*2],0);
  270.                                              { ... their identifications }
  271.   OutTextXY (135,97,'- Power Pack'); OutTextXY (135,108,'- Electronic Key');
  272.   OutTextXY (135,120,'- Crystal'); OutTextXY (135,141,'- You');
  273.   OutTextXY (135,165,'- Alien Androids');
  274.  
  275.   TextSize (4,3,1,1);
  276.   OutTextXY (45,27,'Please choose your skill level :');
  277.   SetColor (2);
  278.   OutTextXY (87,45,'1) Novice Beginner');
  279.   OutTextXY (85,55,'2) Experienced Explorer');
  280.   OutTextXY (85,65,'3) Space Warrior');
  281.   OutTextXY (85,75,'Q) Quit Space Adventure');
  282.   repeat
  283.     K1 := ReadKey;
  284.     Val (K1,Skill,Code);
  285.   until (Skill in [1..3]) or (K1 in ['Q','q']);
  286.   if K1 in ['Q','q'] then begin                          { Player quits }
  287.     SaveHiScores;                                        { Save scores }
  288.     CloseGraph;
  289.     TextMode (Co80);
  290.     Writeln ('Cliche time: May the force be with you!');
  291.     Halt;
  292.   end;
  293.   TextSize (1,1,1,1);
  294.   ClearDevice;
  295.   InitShip;
  296.   SetColor(2);                               { Put up information part }
  297.   Rectangle (0,158,319,169);
  298.   OutTextXY (123,134,'Keys');
  299.   OutTextXY (183,134,'Crystals');
  300.   OutTextXY (250,134,'Power Packs');
  301.   LifeSupp:=230; WSupp[Phaser]:=230; WSupp[Blaster]:=230;
  302.   SetColor(1); TextSize (9,10,4,5);
  303.   OutTextXY (0,169,'LIFE SUPPORT'); OutTextXY (100,169,'(F1 CHARGE)');
  304.   OutTextXY (0,179,'PHASER'); OutTextXY (100,179,'(F3 CHARGE)'); OutTextXY (210,179,'(F4 SELECT)');
  305.   OutTextXY (0,189,'BLASTER'); OutTextXY (100,189,'(F5 CHARGE)'); OutTextXY (210,189,'(F6 SELECT)');
  306.   Weapon:=Blaster; SelectWeapon (Phaser);
  307.   DrawBar (LifeSupp,178,True);
  308.   DrawBar (WSupp[Phaser],188,False);
  309.   DrawBar (WSupp[Blaster],198,False);
  310.   SetColor(3); TextSize (1,1,1,1);
  311.   for Ctr:=0 to 3 do begin
  312.     OutTextXY (115+12*Ctr,145,St(Ctr+1));
  313.     KeyCarried[Ctr]:=False;
  314.   end;
  315.   Level:=2; ShipX:=6; ShipY:=1;                        { Init game variables }
  316.   Xm:=154; Ym:=55; Xd:=0; Yd:=0; Xod:=-1; Yod:=0;
  317.   Xb:=0; Yb:=0; Xbd:=0; Ybd:=0; Bul:=False;
  318.   Man:=1; Walk:=False; WlkC:=0;
  319.   Crystals:=0; Ppacks:=0; Keys:=0;
  320.   K1:=#0; K3:=#0;
  321.   MessCnt:=0;
  322.   Ox:=0; Oy:=0;
  323.   RobotsKilled := 0;
  324.   PpacksUsed := 0;
  325.   Rooms := 0;
  326.   DrawMap (Level);                                { Map of start level (2) }
  327.   Pause := TempPause;
  328. end;
  329.  
  330.  
  331.                                               (**** BULLET PROCESSING ****)
  332. procedure Bullet(x,y,xd,yd,c:word);
  333. begin
  334.   SetColor (c);
  335.   Line (x,y,x+xd,y+yd);
  336. end;
  337.  
  338. function BulletValid(x,y,xd,yd:word):boolean;
  339. begin
  340.   BulletValid := ((GetPixel(x,y)=0) and (GetPixel(x+xd,y+yd)=0) and
  341.                   (x<317) and (x>2) and (y<Swall+1) and (y>3));
  342. end;
  343.                                                    (**** MOVE A ROBOT ****)
  344. procedure PutRobot(No:word);
  345. var Xdif,Ydif:integer;
  346. begin
  347.   with Robot[No] do begin
  348.     if Xr>0 then PutImage (Xr,Yr,Icon[5+Typ*2+Ord(Xr<=Xm)],NormalPut);
  349.     if (not Bl) and (Xr>0) then begin
  350.       if Random(50-(10*Skill)-(3*Crystals))=1 then begin
  351.         if Xm<Xr then Xrb:=Xr-1 else Xrb:=Xr+11;
  352.         Yrb:=Yr+8;
  353.         Xdif:=Xm-Xr; Ydif:=Ym-Yr;
  354.         if Xdif<>0 then Xrbd:=Xdif div Abs(Xdif);
  355.         if Ydif<>0 then Yrbd:=Ydif div Abs(Ydif);
  356.         if Abs(Ydif)<Abs(Xdif div 3) then Yrbd:=0;
  357.         if Abs(Xdif)<Abs(Ydif div 3) then Xrbd:=0;
  358.         if BulletValid(Xrb,Yrb,Xrbd,Yrbd) then begin
  359.           Sound (600);
  360.           Bl:=True;
  361.           Bullet (Xrb,Yrb,Xrbd,Yrbd,3);
  362.         end;
  363.       end;
  364.     end else begin
  365.       Bullet (Xrb,Yrb,Xrbd,Yrbd,0);
  366.       Inc (Xrb,Xrbd*2); Inc (Yrb,Yrbd*2);
  367.       if not BulletValid(Xrb,Yrb,Xrbd,Yrbd) then begin
  368.         Bl:=False;
  369.         if (Xrb>=Xm-1) and (Xrb<=Xm+13) and
  370.            (Yrb>=Ym-1) and (Yrb<=Ym+21) then begin
  371.           PutImage(Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],NotPut);
  372.           Sound (900);
  373.           DecSupport(LifeSupp,5,178);
  374.         end;
  375.       end else Bullet (Xrb,Yrb,Xrbd,Yrbd,3);
  376.     end;
  377.   end;
  378.   SetColor (0); NoSound;
  379. end;
  380.  
  381. procedure HitRobot;
  382. begin
  383.   Hit:=0;
  384.   NoSound;
  385.   Inc (Xb,Xbd*2); Inc (Yb,Ybd*2);
  386.   for Ctr:=1 to Robots do with Robot[Ctr] do if Xr>0 then
  387.     if (Xb>=Xr-1) and (Xb<=Xr+11) and
  388.        (Yb>=Yr-1) and (Yb<=Yr+21) then Hit:=Ctr;
  389.   if Hit>0 then with Robot[Hit] do begin
  390.     PutImage(Xr,Yr,Icon[5+Typ*2+Ord(Xr<=Xm)],NotPut);
  391.     Sound (850); Delay (4);
  392.     Dec(Power,2+Ord(Weapon)*2);
  393.     if (Power=0) or (Power>250) then begin
  394.       NoSound;
  395.       Delay (200);
  396.       for Ctr:=1 to 1000 do begin
  397.         Sound (Random (1000-Ctr));
  398.         PutPixel (Xr+Random(11),Yr+Random(21),0);
  399.         Sound (10000);
  400.       end;
  401.       Black(Xr,Yr,Xr+10,Yr+20);
  402.       Xr:=0; Dec (RobotsLeft);
  403.       Inc (RobotsKilled);
  404.     end;
  405.     NoSound;
  406.   end;
  407. end;
  408.                                                (***** DRAW CURRENT ROOM ****)
  409. procedure InitRoom(Interior:word; Obj,Robs:byte; Visited:boolean);
  410. var x,y:byte;
  411.     Crash:boolean;
  412. begin
  413.   UpdateMap (Level,ShipX,ShipY,True);
  414.   if not Visited then Inc (Rooms);
  415.   SetLineStyle(0,0,3); SetColor (3);
  416.   Rectangle (1,1,318,Swall+3); SetColor (0);
  417.   if (Interior and North)>0 then Line (160-30,2,160+30,2);
  418.   if (Interior and South)>0 then Line (160-30,Swall+2,160+30,Swall+2);
  419.   if (Interior and West)>0 then Line (2,66-19,2,66+19);
  420.   if (Interior and East)>0 then Line (317,66-19,317,66+19);
  421.  
  422.   if (Interior and Shield)>0 then begin
  423.     PutImage (160-35-15,66-15,Icon[13],0);
  424.     PutImage (160+35,66-15,Icon[14],0);
  425.   end;
  426.   if (Interior and Block)>0 then for x:=0 to 1 do for y:=0 to 1 do
  427.     PutImage (85+x*141,30+y*62,Icon[15],0);
  428.   SetColor (3);
  429.   if (Interior and Pform)>0 then for y:=0 to 1 do
  430.     PutImage (160-20,37+y*54,Icon[20],0);
  431.   SetLineStyle (0,0,0); SetColor (0);
  432.   if (Interior and Panel)>0 then PutImage (160-40,49,Icon[19],0);
  433.  
  434.   CurrObj:=Obj; if Obj>0 then begin
  435.     Obx:=Icon[ObjIcon[Obj]][1] div 2; Oby:=Icon[ObjIcon[Obj]][3] div 2;
  436.     PutImage (160-Obx,65-Oby,Icon[ObjIcon[Obj]],0);
  437.   end;
  438.  
  439.   PutImage (Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],0);
  440.  
  441.   RobotsLeft:=0; Robots:=0;
  442.   if (not Visited) and (Robs>0) then begin
  443.     Robots:=Robs; RobotsLeft:=Robs;
  444.     for Ctr:=1 to Robots do
  445.       with Robot[Ctr] do begin
  446.         repeat
  447.           Crash:=False;
  448.           Xr:=Random(300)+3;
  449.           Yr:=Random(Swall-25)+3;
  450.           if (Interior>15) or (Obj>0) then if (Xr>65) and (Xr<240) and (Yr>8) and (Yr<115) then Crash:=True;
  451.           if Ctr>1 then for Ctr2:=1 to Ctr-1 do
  452.             if (Xr+13>=Robot[Ctr2].Xr) and (Xr<=Robot[Ctr2].Xr+13) and
  453.               (Yr+21>=Robot[Ctr2].Yr) and (Yr<=Robot[Ctr2].Yr+21) then Crash:=True;
  454.           if (Xr+15>=Xm) and (Xr<=Xm+15) and (Yr+21>=Ym) and (Yr<=Ym+21) then Crash:=True;
  455.         until (not Crash);
  456.         Xrd:=Random(3)-1; Yrd:=Random(3)-1;
  457.         Typ:=Random (4);
  458.         Power:=6+Skill+Crystals+Typ*2;
  459.         Bl:=False;
  460.       end;
  461.     for Ctr:=0 to 750 do begin
  462.       for Ctr2:=1 to Robots do with Robot[Ctr2] do
  463.         PutPixel (Xr+Random(11),Yr+Random(21),Random(4));
  464.       Sound (Random(Ctr*2));
  465.     end;
  466.     for Ctr:=1 to Robots do PutRobot(Ctr);
  467.   end;
  468. end;
  469.  
  470. procedure TakeObjekt;
  471. begin
  472.   if CurrObj>Ord((CurrObj=1) and (Ppacks=4)) then
  473.     if (Xm+12+Xd>=160-Obx) and (Xm+Xd<=161+Obx) and
  474.        (Ym+20+Yd>=65-Oby) and (Ym+Yd<=66+Oby) then begin
  475.          Black(160-Obx,65-Oby,161+Obx,66+Oby);
  476.                  Ship[Level,ShipX,ShipY].Objekt:=0;
  477.          case ObjIcon[CurrObj] of
  478.            16: begin
  479.                  Inc(Ppacks);
  480.                  PutImage(255+Ppacks*10,146,Icon[16],0);
  481.                end;
  482.            17: begin
  483.                  KeyCarried[CurrObj-Key]:=True;
  484.                  PutImage(114+(CurrObj-Key)*12,147,Icon[17],0);
  485.                  Inc (Keys);
  486.                end;
  487.            18: begin
  488.                  PutImage(175+Crystals*16,145,Icon[18],0);
  489.                  Inc (Crystals);
  490.                  if Crystals=4 then begin
  491.                    Message ('Good job! Now return to your ship!');
  492.                    MessCnt := 1;
  493.                  end;
  494.                end;
  495.          end;
  496.          Play ('t255 l8 o5 c>c<c>c<c>c<c');
  497.          CurrObj:=0;
  498.        end;
  499. end;
  500.                                                      (**** LOCKED DOOR? ****)
  501. procedure CheckLockedDoor;
  502. var BehindDoor:byte;
  503. begin
  504.     BehindDoor:=Ship[Level,ShipX,ShipY].Objekt;
  505.   if BehindDoor>=Crystal then
  506.     if KeyCarried[BehindDoor-Crystal] then begin
  507.       if MessCnt>0 then ClearMessage;
  508.       Message ('Electronic key #'+St(BehindDoor-Crystal+1)+' opens the door');
  509.       MessCnt:=1;
  510.     end else begin
  511.       Message ('This door is locked ! Requires electronic key #'+St(BehindDoor-Crystal+1));
  512.       MessCnt:=1;
  513.       ShipX:=Ox; ShipY:=Oy;
  514.     end;
  515. end;
  516.                                               (**** MOVEMENT PROCESSING ****)
  517. procedure Gun (x,y:integer);
  518. begin
  519.   if (x<>0) and (y<>0) then PutPixel (Xm+(12*Ord(Man=3)),Ym+10,0);
  520.   PutPixel (Xm+(12*Ord(Man=3)),Ym+10+y,1);
  521. end;
  522.  
  523. procedure Dir(x,y:integer);
  524. begin
  525.   if (x<>0) or (y<>0) then begin
  526.     Xod:=x; Yod:=y;
  527.   end;
  528.   Xd:=x; Yd:=y;
  529.   if Xd<0 then Man:=1;
  530.   if Xd>0 then Man:=3;
  531. end;
  532.  
  533. function Stop(x,y,xd,yd:word):boolean;
  534. var x1,y1:word;
  535. begin
  536.   Stop:=False;
  537.   if xd<>0 then begin
  538.     x1:=x+xd+(Width*ord(xd=1));
  539.     for y1:=y+yd to y+20+yd do
  540.       if GetPixel(x1,y1)>0 then Stop:=True;
  541.   end;
  542.   if yd<>0 then begin
  543.     y1:=y+yd+(20*ord(yd=1));
  544.     for x1:=x+xd to x+Width+xd do
  545.       if GetPixel(x1,y1)>0 then Stop:=True;
  546.   end;
  547. end;
  548.                                                 (**** MOVE MAN ****)
  549. procedure MoveMan;
  550. begin
  551.   if KeyPressed then begin
  552.     K1:=ReadKey;
  553.     case K1 of
  554.       #0 : if KeyPressed then begin
  555.              K2:=ReadKey;
  556.              if K2=K3 then begin
  557.                Dir (0,0); K3:=#0;
  558.              end else begin
  559.                case K2 of
  560.                  'G': Dir (-1,-1);
  561.                  'H': Dir (0,-1);
  562.                  'I': Dir (+1,-1);
  563.                  'K': Dir (-1,0);
  564.                  'M': Dir (+1,0);
  565.                  'O': Dir (-1,+1);
  566.                  'P': Dir (0,+1);
  567.                  'Q': Dir (+1,+1);
  568.  
  569.                  ';': UsePpack (LifeSupp,178);
  570.                  '=': UsePpack (WSupp[Phaser],188);
  571.                  '>': SelectWeapon (Phaser);
  572.                  '?': UsePpack (WSupp[Blaster],198);
  573.                  '@': SelectWeapon (Blaster);
  574.  
  575.                  'Z': Inc (Pause,3);
  576.                  'A': Dec (Pause,3);
  577.  
  578.                  'B': begin
  579.                         Noise := not Noise;
  580.                         Sound (700);
  581.                         Delay (70);
  582.                       end;
  583.  
  584.                  'C': begin
  585.                         Inc (Gm);
  586.                         if Gm>3 then Gm:=0;
  587.                         Palette (Gm);
  588.                       end;
  589.                  'D': begin
  590.                         Inc (BkColor);
  591.                         if BkColor>15 then BkColor:=0;
  592.                         GraphBackground (BkColor);
  593.                       end;
  594.                end;
  595.                if K2 in ['G'..'Q'] then K3:=K2;
  596.                if Pause<0 then Pause:=0;
  597.                if Pause>100 then Pause:=100;
  598.              end;
  599.            end;
  600.       #32: if (not Bul) and (RobotsLeft>0) and (WSupp[Weapon]>0) then begin
  601.              if Man=1 then Xb:=Xm else Xb:=Xm+12;
  602.              Xb:=Xb+Xod;
  603.              Yb:=Ym+10+2*Yod;
  604.              Xbd:=Xod; Ybd:=Yod; Code:=0;
  605.              if Weapon = Phaser then Sound (3000);
  606.              Sound (BulSound);
  607.              if BulletValid(Xb,Yb,Xbd,Ybd) then begin
  608.                Bul:=True; Dist :=0;
  609.                Bullet (Xb,Yb,Xbd,Ybd,3);
  610.              end else HitRobot;
  611.              if Weapon=Phaser then DecSupport (WSupp[Phaser],4,188)
  612.                               else DecSupport (WSupp[Blaster],8,198);
  613.            end;
  614.       #27: begin
  615.              ClearMessage;
  616.              Message ('Really want to end this game? (Y/N)');
  617.              repeat K2:=UpCase(ReadKey); until K2 in ['Y','N'];
  618.              ClearMessage;
  619.              if k2='N' then K1:=#0;
  620.            end;
  621.     end;
  622.   end;
  623.   if Bul then begin
  624.     Bullet (Xb,Yb,Xbd,Ybd,0);
  625.     Inc (Xb,Xbd*2);
  626.     Inc (Yb,Ybd*2);
  627.     if Dist<3000 then begin
  628.       Inc (Dist,150);
  629.       if Weapon = Phaser then Sound (3000-Dist)
  630.                          else Sound (Dist);
  631.       Sound (BulSound);
  632.     end;
  633.     if not BulletValid(Xb,Yb,Xbd,Ybd) then begin
  634.       Bul:=False;
  635.       HitRobot;
  636.     end else Bullet (Xb,Yb,Xbd,Ybd,3);
  637.     SetColor (0);
  638.   end;
  639.   NoSound;
  640.   if not Stop(Xm,Ym,Xd,Yd) then begin
  641.     case Xd of
  642.       -1: Line (Xm+12,Ym,Xm+12,Ym+20);
  643.       +1: Line (Xm,Ym,Xm,Ym+20);
  644.     end;
  645.     case Yd of
  646.       -1: Line (Xm,Ym+20,Xm+12,Ym+20);
  647.       +1: Line (Xm,Ym,Xm+12,Ym);
  648.     end;
  649.     Xm:=Xm+Xd; Ym:=Ym+Yd;
  650.     Inc(WlkC);
  651.     if WlkC>15 then begin
  652.       Walk:=not Walk;
  653.       WlkC:=0;
  654.     end;
  655.     end else TakeObjekt;
  656.   PutImage (Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],0);
  657.   Gun (Xod,Yod);
  658. end;
  659.                                                (***** MOVE ROBOTS ****)
  660. procedure MoveRobots;
  661. var stp:boolean;
  662. begin
  663.   Width:=10;
  664.   for Ctr:=1 to Robots do
  665.   with Robot[Ctr] do if (Xr>0) or Bl then begin
  666.     if Xr>0 then begin
  667.       stp:=Stop(Xr,Yr,Xrd,Yrd);
  668.       if not Stp then begin
  669.         case Xrd of
  670.           -1: Line (Xr+10,Yr,Xr+10,Yr+20);
  671.           +1: Line (Xr,Yr,Xr,Yr+20);
  672.         end;
  673.         case Yrd of
  674.           -1: Line (Xr,Yr+20,Xr+10,Yr+20);
  675.           +1: Line (Xr,Yr,Xr+10,Yr);
  676.         end;
  677.         Xr:=Xr+Xrd; Yr:=Yr+Yrd;
  678.       end;
  679.       if Random(30-Ord(Stp)*20-Skill*3)=0 then begin
  680.         Xrd:=Random (3)-1; Yrd:=Random (3)-1;
  681.       end;
  682.     end;
  683.     PutRobot (Ctr);
  684.   end;
  685.   Width:=12;
  686. end;
  687.  
  688. procedure Game;
  689. begin
  690.   repeat
  691.     Teleport := ((ShipX in [1,12]) and (ShipY=2)) and Leave;
  692.     Xm:=Xm+15*Ord(Teleport)*Xd;
  693.     if (ShipX<>Ox) or (ShipY<>Oy) then with Ship[Level,ShipX,ShipY] do
  694.             InitRoom(Interior,Objekt,Random(3+Ord(Skill=3)),Visited);
  695.                                                          (**** TELEPORT ****)
  696.     if Teleport then begin
  697.       PutImage (Xm,Ym,Icon[Man],0);
  698.       Message ('Teleport room. Which level ? (1-3)');
  699.       repeat Val(Readkey,NewLevel,Code); until (NewLevel>0) and (NewLevel<4);
  700.       ClearMessage;
  701.       UpdateMap(Level,ShipX,ShipY,False);
  702.       if NewLevel=Level then ShipX:=Ord(ShipX=12)+Ord(ShipX=1)*12
  703.         else DrawMap (NewLevel);
  704.       Level:=NewLevel; Leave:=False;
  705.       UpdateMap(Level,ShipX,ShipY,False);
  706.     end else begin
  707.                                                    (***** MAIN LOOP *****)
  708.       repeat
  709.         MoveMan;
  710.         MoveRobots;
  711.         if MessCnt>0 then begin
  712.           Inc(MessCnt); if MessCnt=80 then begin
  713.             ClearMessage; MessCnt:=0; end;
  714.         end;
  715.         Crt.Delay(Pause);
  716.         Leave:=((Xm<=1) or (Xm>=306) or (Ym<=1) or (Ym+17>=Swall)) and (RobotsLeft=0);
  717.         Dead:=(LifeSupp=0) or (K1=#27) or
  718.               ((WSupp[Phaser]=0) and (WSupp[Blaster]=0) and (Ppacks=0) and
  719.                (CurrObj<>Ppack) and (RobotsLeft>0));
  720.         Done:=((Crystals=4) and (Level=2) and (ShipX=6) and (ShipY=1));
  721.       until Leave or Dead or Done;
  722.  
  723.       if Leave then begin
  724.         Ox:=ShipX; Oy:=ShipY;
  725.         Ship[Level,ShipX,ShipY].Visited:=True;
  726.         ShipX:=ShipX+Ord(Xm>=306)-Ord(Xm<=1);
  727.         ShipY:=ShipY+Ord(Ym+21>=Swall)-Ord(Ym<=1);
  728.  
  729.         CheckLockedDoor;
  730.  
  731.         if (ShipX<>Ox) or (ShipY<>Oy) then begin
  732.           if Xm<=1 then Xm:=305 else if Xm>=306 then Xm:=2;
  733.           if Ym<=1 then Ym:=SWall-18 else if Ym+17>=Swall then Ym:=2;
  734.           Bul:=False;
  735.           UpdateMap (Level,Ox,Oy,False);
  736.         end;
  737.       end;
  738.     end;                                 (**** CLEAR ROOM ****)
  739.     if ((ShipX<>Ox) or (ShipY<>Oy)) and not (Dead or Done) then
  740.       if PCCompatible then begin
  741.         FillChar (Scr,5440,0);
  742.         FillChar (Scr2,5440,0);
  743.       end else Black (0,0,319,150);
  744.   until Dead or Done;
  745. end;
  746.  
  747. procedure Finish;
  748. var Txt:str80;
  749. begin
  750.   TempPause := Pause;
  751.   Pause := 0;
  752.   if Dead then begin
  753.     PutImage (Xm,Ym,Icon[Man+Ord(Walk and ((Xd<>0) or (Yd<>0)))],NotPut);
  754.     Delay (600);
  755.     for Ctr:=1 to 1700 do begin
  756.       Sound (1750-Ctr); Delay (1);
  757.       Sound (Ctr);
  758.       PutPixel (Xm+Random(13),Ym+Random(21),0);
  759.     end;
  760.   end;
  761.   NoSound;
  762.   Black(Xm,Ym,Xm+12,Ym+20);
  763.   if Done then begin
  764.     PutImage (154,55,Icon[1],NormalPut);
  765.     Delay (600);
  766.     TheEnd;
  767.   end else begin
  768.     Message ('You failed completing SPACE ADVENTURE! Press a key.');
  769.     while KeyPressed do K1:=ReadKey;
  770.     K1:=ReadKey;
  771.   end;
  772.   Score := Evaluation;
  773.   ShowHiScores (Score);
  774. end;
  775.  
  776.  
  777.         (******************  M A I N    P R O G R A M  *****************)
  778.  
  779. begin
  780.   Initialize;
  781.   repeat
  782.     ShowTitle;
  783.     InitGame;
  784.         Game;
  785.     Finish;
  786.   until False = True;
  787. end.
  788.